Amiga Developer CD 2.1/Amiga Developer CD v2.1.iso/Reference/DevCon/Orlando_1993/Devcon93.1/AREXX/ttx/ASCII2AG.ttx

Text File | 1993-01-11 | 6.1 KB | 245 lines

/**********************************************************

        (c) Copyright 1992-93 Commodore-Amiga, Inc.
                   All rights reserved.

This software is provided as-is and is subject to change;
no warranties are made.  All use is at your own risk.  No
liability or responsibility is assumed.


              $VER: ASCII2AG.ttx 1.00 (07.01.93)
            ----------------------------------
      Make an ASCII file into an AmigaGuide database.
          File must specify where nodes start by:

             <node#>@<node name> <node title>

                 Written by Jerry Hartzler

**********************************************************/

options results

setinputlock on
getport                        /* Get some file information */
workport=result
getfilepath
file=result
getfileinfo
parse var result . . filename
filename=compress(filename,'" ')

getprefs findbackward              /* Save User prefs and */
fbw=result                          /* setup program prefs */
getprefs findignorecase
fic=result
getprefs findstring
fs=result
getprefs findwholewords
fww=result
setprefs findbackward off
setprefs findignorecase on
setprefs findwholewords off

/**********************************************************
       Check work file for correct node formatting
**********************************************************/

err=0
SetStatusBar Temporary 'Error Checking...'
movesof
insertline
moveup
lchar=0

movesof                     /* Check if there are any nodes */
find '?@'
if rc~=0 then do
    message='"No nodes found!"'
    call error1
    end

else do                   /* Check if 1st node is MAIN (0@) */
    getchar
    if result~=0 then do
        message='"First section tag is not 0@"'
        call error1
        end

    find '0@'      /* Check if more MAIN nodes are found */
    if rc=0 then do
        message='File must have only one 0@'
        call error2
        end
    end

do forever      /* Check if Nodes are in squential order */
    find '?@'
    if rc~=0 then break
    call position
    llin=lin
    if col=1 then do
        getchar
        char=result
        test=datatype(char)
        if test='NUM' then do
            if char<lchar then lchar=char
            if lchar~=char & lchar+1~=char then do
                message='Section numbers not in sequentual order'
                call error2
                end
            lchar=char
            end

        moveright 2              /* Check if two nodes   */
        getchar                  /* have identical names */
        nchar=C2D(result)
        if nchar~=32 & nchar~=10 then do
            setprefs findignorecase off
            setprefs findwholewords on
            setbookmark 1
            getword
            fword='?'substr(result,2)
            do forever
                find fword
                if rc~=0 then break
                call position
                if col=1 then do
                    message='Same NODE names: lines' llin-1 '&' lin-1
                    call error2
                    end
                end
            setprefs findignorecase on
            setprefs findwholewords off
            movebookmark 1
            end
        end
    end

/**********************************************************
          Format work file as AmigaGuide database
**********************************************************/

movesof                    /* Make work file an AG database */
text '@DATABASE'

if stnode=1 then do             /* Insert MAIN (0@) node */
    insertline                  /* if one does not exist */
    text '0@'
    movesof
    end

nodenum=0
endnum=0
lchar=1
do forever
    node=''
    find '?@'
    if rc~=0 then leave     /* exit when ?@ is not found */

    getcursorpos         /* does ?@ start on 1st column? */
    parse var result . col .

    if col=1 then do
        getchar
        char=result

        if char=0 then do          /* 0@ is the MAIN node */
            node='MAIN'
            end

        else do                  /* every NODE must have */
            text '@ENDNODE'      /* an ENDNODE           */
            insertline
            end

        delete
        getline 2
        line=result             /* Call to parse ?@ line */
        call nodename           /* for any NODE info     */
        moveright 1
        deleteeol
        text 'NODE' node name               /* Make NODE */
        movesol
        test=datatype(char)

        if char~=0 & test='NUM' then do
            moveup                      /* Make Link Point */
            setbookmark endnum        /* for NODE        */
            movebookmark char-1
            if strip(name,'b','"')='' then name=node
            text '@{'name 'link' node'}' /* ^if no title */
            insertline               /* use name of NODE */
            setbookmark char-1
            movebookmark endnum
            movedown
            endnum=char
            end
        end
    end

moveeof
text '@ENDNODE'        /* Insert ENDNODE at end of database */
insertline
call quit

/**********************************************************
                          Calls
**********************************************************/


nodename:                 /* Parse ?@ line for NODE info */
    name=''
    if length(line)>0 then do
        if C2D(left(line,1))~=32 & node='' then do
            node='"'subword(line,1,1)'"' /* Get NODE name */
            line=subword(line,2)
            end
        if length(line)>0 then name='"'strip(line,'b','" ')'"'
        else name=''                  /* ^Get NODE title */
        end
    if node='' then do            /* If NODE has no name */
        nodenum=nodenum+1         /* make one up         */
        node='"'filename'_'nodenum'"'
        end
    return


position:                         /* Find column position */
    getcursorpos
    parse var result lin col .
    return


error1:               /* Does user want a MAIN (?@) node */
    requestbool TITLE message PROMPT '"Make One?  OK=Yes CANCEL=No"'
    if result='NO' then call error2
    stnode=1
    return


error2:            /* Change work file to the way it was */
    err=1
    setbookmark 1
    movesof
    delete
    movebookmark 1
    beepscreen
    SetStatusBar message
    call quit


quit:                                         /* Bye Bye */
    address value workport     /* Set back to user Prefs */
    setprefs findbackward fbw
    setprefs findignorecase fic
    setprefs findstring fs
    setprefs findwholewords fww
    setinputlock off
    if err=0 then do
        movesof
        SetStatusBar 'Operation Complete'
        end
    exit